home *** CD-ROM | disk | FTP | other *** search
/ User's Choice Windows CD / User's Choice Windows CD (CMS Software)(1993).iso / windows1 / ew100.zip / FILES1.LZH / BEGINEND.PAS < prev    next >
Pascal/Delphi Source File  |  1992-11-29  |  8KB  |  255 lines
  1. {************************************************}
  2. {                                                }
  3. { E! for Windows                                 }
  4. { (c) - Patrick Philippot - 1992                 }
  5. {                                                }
  6. { Sample Extension DLL                           }
  7. {                                                }
  8. { This DLL implements an extension to the        }
  9. { Check Brace function. The original function    }
  10. { doesn't take into account the BEGIN/END,       }
  11. { CASE/END or REPEAT/UNTIL pairs of the Pascal   }
  12. { language. If loaded, this DLL will extend the  }
  13. { search and find the above matching pairs.      }
  14. {                                                }
  15. {************************************************}
  16.  
  17. (*
  18. To use this DLL simply load it from the user menu or add its name to the
  19. list of autoloaded Extension DLLs using the Autoload dialog box from
  20. the User Menu of EW. That's all. This extension cannot be executed because
  21. it only adds a hook to the CheckBrace function and exports no EWExecute
  22. function.
  23.  
  24. BEGINEND will check if the standard CheckBrace function failed and will try
  25. to find a BEGIN/END, CASE/END or REPEAT/UNTIL pair. BEGINEND will fail if the
  26. word at the cursor position doesn't belong to that list.
  27.  
  28. Once BEGINEND has been loaded, Ctrl H (default assignment) will trigger the
  29. CheckBrace function and pass along control to BEGINEND in case of failure.
  30.  
  31. BEGINEND works in both directions. If you set the cursor under BEGIN, CASE or
  32. REPEAT, it will search forward for END or UNTIL, otherwise if you set the
  33. cursor under UNTIL or END, it will look backward for a matching BEGIN, CASE
  34. or REPEAT.
  35.  
  36. Of course, nested pairs are ignored as well as keywords enclosed within
  37. comment braces.
  38.  
  39. BEGINEND uses the FuncExitHook provided by the EW API and some other API
  40. services giving information about the current Editor.
  41. *)
  42.  
  43. {$IFDEF DEBUG}
  44. {$A-,G+,B-,D+,F+,I-,N-,R+,S-,V-,L+}
  45. {$ELSE}
  46. {$A-,G+,B-,D-,F+,I-,N-,R-,S-,V-,L-}
  47. {$ENDIF}
  48.  
  49. library BeginEnd;
  50.  
  51. uses WinTypes, EWApiImp, Strings;
  52.  
  53. {$I ewuser.inc}
  54.  
  55. var
  56.   SaveExit  : Pointer;
  57.   BufIndex,
  58.   LineIndex,
  59.   MaxIndex  : integer;
  60.   Len       : word;
  61.  
  62.  
  63. function SearchMatchingItem : boolean;
  64.  
  65. type
  66.   longrec = record
  67.     LoW, HiW : integer;
  68.   end;
  69.  
  70. var
  71.   newch,
  72.   ch            : char;
  73.   CommentLevel  : integer;
  74.   XYPos         : longint;
  75.   PairCount     : word;
  76.   Linebuffer    : array[0..255] of char;
  77.   bForward,
  78.   bDone         : boolean;
  79.  
  80.   function GetChar : char;
  81.  {-Retrieve characters from the text flow}
  82.   begin
  83.     if bForward then begin
  84.       Inc(BufIndex);
  85.       if BufIndex >= Len then begin
  86.         Inc(LineIndex);
  87.         if LineIndex <= MaxIndex then begin
  88.           while StrUpper(StrCopy(LineBuffer, EwGetLineAt(LineIndex)))[0] = #0 do begin
  89.             Inc(LineIndex);
  90.             if LineIndex > Maxindex then begin
  91.               GetChar := #0;
  92.               Exit;
  93.             end;
  94.           end;
  95.           Len := StrLen(LineBuffer);
  96.           BufIndex := 0;
  97.         end else begin
  98.           GetChar := #0;
  99.           Exit;
  100.         end;
  101.       end;
  102.     end else begin
  103.       Dec(BufIndex);
  104.       if BufIndex < 0 then begin
  105.         Dec(LineIndex);
  106.         if LineIndex >= 0 then begin
  107.           while StrUpper(StrCopy(LineBuffer, EwGetLineAt(LineIndex)))[0] = #0 do begin
  108.             Dec(LineIndex);
  109.             if LineIndex < 0 then begin
  110.               GetChar := #0;
  111.               Exit;
  112.             end;
  113.           end;
  114.           Len := StrLen(LineBuffer);
  115.           BufIndex := Pred(Len);
  116.         end else begin
  117.           GetChar := #0;
  118.           Exit;
  119.         end;
  120.       end;
  121.     end;
  122.     GetChar := LineBuffer[BufIndex];
  123.   end;
  124.  
  125.   function MatchPattern(ch : char) : boolean;
  126.  {-Verify if the word beginning at the cursor position match a list member}
  127.   var
  128.     MatchStr : array[0..6] of char;
  129.     MatchEnd : word;
  130.   const
  131.     Delimiters : set of char =
  132.       ['.', ' ', ',', ';', ':', '\', '/', '(', ')', '{', '}', '[', ']', '-'];
  133.   begin
  134.     MatchPattern := false;
  135.     if CommentLevel <> 0 then
  136.       Exit;
  137.     case ch of
  138.       'B' : StrCopy(MatchStr, 'BEGIN');
  139.       'R' : StrCopy(MatchStr, 'REPEAT');
  140.       'U' : StrCopy(MatchStr, 'UNTIL');
  141.       'C' : StrCopy(MatchStr, 'CASE');
  142.       'E' : StrCopy(MatchStr, 'END');
  143.     end;
  144.     MatchEnd := StrLen(MatchStr) + BufIndex;
  145.     MatchPattern :=
  146.       (StrPos(LineBuffer + BufIndex, MatchStr) - LineBuffer = BufIndex)
  147.       and
  148.       ((BufIndex = 0) or (LineBuffer[Pred(BufIndex)] = ' '))
  149.       and
  150.       ((MatchEnd = Len) or ((MatchEnd < Len) and (LineBuffer[MatchEnd] in Delimiters)));
  151.   end;
  152.  
  153. begin
  154.  {-Get current cursor position}
  155.   XYPos := EWGetCaretPos;
  156.   BufIndex := longrec(XYPos).LoW;
  157.   LineIndex := longrec(XYPos).HiW;
  158.  {-Get number of lines in current Editor}
  159.   MaxIndex := Pred(EWGetLineCount);
  160.  {-Get the current line}
  161.   StrUpper(StrCopy(LineBuffer, EwGetLineAt(LineIndex)));
  162.  {-Initialize search data}
  163.   Len := StrLen(LineBuffer);
  164.   CommentLevel := 0;
  165.   bDone := false;
  166.   bForward := Upcase(LineBuffer[BufIndex]) in ['B', 'C', 'R'];
  167.   if bForward then
  168.     Dec(BufIndex)
  169.   else
  170.     Inc(BufIndex);
  171.   SearchMatchingItem := false;
  172.   if not MatchPattern(GetChar) then
  173.     Exit
  174.   else
  175.     PairCount := 1;
  176.   repeat
  177.    {-Read character from text stream and update search variables}
  178.     ch := Upcase(GetChar);
  179.     case ch of
  180.       '{' : Inc(CommentLevel);
  181.       '}' : Dec(CommentLevel);
  182.       '(' : if bForward and (GetChar = '*') then
  183.               Inc(CommentLevel);
  184.       ')' : if not bForward and (GetChar = '*') then
  185.               Inc(CommentLevel);
  186.       '*' : begin
  187.               newch := GetChar;
  188.               if (bForward and (newch = ')')
  189.               or (not bForward and (newch = '('))) then
  190.                 Dec(CommentLevel)
  191.             end;
  192.       'B',
  193.       'R',
  194.       'C' : if MatchPattern(ch) then
  195.               if bForward then
  196.                 Inc(PairCount)
  197.               else
  198.                 Dec(PairCount);
  199.       'U',
  200.       'E' : if MatchPattern(ch) then
  201.               if bForward then
  202.                 Dec(PairCount)
  203.               else
  204.                 Inc(PairCount);
  205.     end;
  206.     if PairCount = 0 then begin
  207.    {-Nesting level returned to 0. A matching sequence has been found}
  208.       SearchMatchingItem := true;
  209.       EWGotoXY(BufIndex, LineIndex);
  210.       bDone := true;
  211.     end;
  212.   until bDone or (ch = #0);
  213.  {-See comments in FunctionExitHook}
  214.   if not bDone then
  215.     EWWriteMessage('No matching sequence found')
  216.   else
  217.     EWWriteMessage(''); {-Clear previous error messages}
  218.   SearchMatchingItem := bDone;
  219. end;
  220.  
  221. function FuncExitHook(command : word; pRetCode : PInteger) : integer; export;
  222. {-Check whether the CheckBrace function succeeded.}
  223. { If not, call SearchMatchingItem}
  224. begin
  225.   FuncExitHook := 0;
  226.  {-Although the present version of the EW API doesn't check the return code}
  227.  { from the FuncExitHook functions, it is good practice to set this value  }
  228.  { to 0.}
  229.   if (command = ew_CheckBrace) and (pRetcode^ <> 0) then
  230.     if SearchMatchingItem then
  231.       pRetcode^ := 0 {-Success. Overwrite error code returned by CheckBrace}
  232.     else
  233.       pRetcode^ := ewerr_EXTFAILED; {-Unique exit code signaling that the}
  234.                                     { extension function failed.}
  235.   {-You may also leave pRetcode^ unchanged and let EW display its usual }
  236.   { message. In that case EW would issue no message at all, so it's pre-}
  237.   { ferable to handle this ourselves.}
  238.  
  239. end;
  240.  
  241. procedure LibExit; far;
  242. begin
  243.   EWRemoveHook(EWHook_FunctionExit, @FuncExitHook);
  244.   ExitProc := SaveExit;
  245. end;
  246.  
  247. exports
  248.   FuncExitHook   index 1;
  249.  
  250. begin
  251.   EWSetHook(EWHook_FunctionExit, @FuncExitHook);
  252.   SaveExit := ExitProc;
  253.   ExitProc := @LibExit;
  254. end.
  255.